home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
SPACE 1
/
SPACE - Library 1 - Volume 1.iso
/
program
/
16
/
tasking.fth
< prev
next >
Wrap
Text File
|
1985-11-19
|
5KB
|
174 lines
\ Multitasking
\ TODO:
\ Make booting equivalent to task activation
\ This may involve putting some of the task activation words in code
\ Low level multi-tasking words
\ The low-level "name" of a task is the address of its user area
0 \ save space on the stack for later
code (pause (s -- ) \ go see if anybody else wants service
th e000 # 'user saved-ip movem \ save ip, rp, sp
drop here \ remember the address of the next-task code
forth ' link assembler >user# up d) up move \ get up for new task
'user entry a0 move \ get pc for new task
a0 ) jmp
c;
constant to-next-task (s -- address-of-"next-task"-code )
\ Called with up set to the user area address of the task to run
create task-resume (s -- ) \ start a task
assembler long
'user saved-ip th e000 # movem \ restore ip,rp,sp
next
forth
up@ link ! \ point the current task to itself
: local (s task-base user-var-addr -- user-var-addr-in-tasks-space )
up@ - +
;
: sleep (s task-addr -- ) to-next-task swap entry local ! ;
: wake (s task-addr -- ) task-resume swap entry local ! ;
: stop (s -- ) \ put current task to sleep
up@ sleep (pause
;
\ single is already defined in the kernel
\ : single (s -- ) \ disable pausing - current task gains exclusive control
\ ['] noop ['] pause (is
\ ;
: multi (s -- ) \ initialize multitasking
init-malloc
up@ wake \ Make sure the main task is awake
['] (pause ['] pause (is
;
\ Layout of private storage for a new task:
\ Space Size
\ ----- ----
\ User Area user-size
\ Dictionary variable
\ Parameter Stack variable
\ Tib task-rs-size
\ Return Stack task-rs-size
\ .
\ The dictionary and the Parameter Stack share an area equal
\ to the task storage area size minus user-size minus task-rs-size
\
\ The terminal input buffer and the Return Stack share an area of
\ size task-rs-size. Tib grows up, Return Stack grows down.
80 20 /n* + constant task-rs-size
\ Before the new task has been forked, invoking the task name will
\ return its pfa. After it has been forked, it will return the
\ address of its user area
\ Pfa of task contains the address and size
: "task: ( size name -- ) \ name and allocate a new task
"create ( size )
here , , does> @
;
: default-task-size ( -- size )
user-size th 200 +
;
: task: ( size -- name ) \ name and allocate a new task using a default size
default-task-size bl word "task:
;
nuser task-size
nuser task-word
\ Allocate and initialize the user area for the new task, schedule it
: tfork ( task-pfa -- task-user-area )
\ Allocate run-time space
dup na1+ @ ( task-pfa task-size)
dup alloc-mem ( task-pfa task-size task-address)
\ Initialize the user area with a copy of the current task's user area
up@ over #user @ cmove ( task-pfa task-size task-address)
\ Since we copied the user area, his link already points to my successor.
\ Now make him my new successor in the task queue.
dup link !
\ Save my UP and switch to his user area
up@ >r up! ( task-pfa task-size)
\ Fix the parameter field of the task word so it points to the new
\ user area instead of to itself
up@ rot ! ( task-pfa )
\ Set the task address and task size user variables
dup task-size !
up@ + ( top-of-task-data-area )
dup rp0 ! ( top-of-task-data-area )
task-rs-size - sp0 !
up@ up0 !
up@ user-size + dp !
\ Put him to sleep
up@ sleep
\ Restore my up
up@ r> up!
;
\ Restart the task using its word to execute
: set-task ( ip task -- )
up@ -rot up! ( my-up ip )
\ Initialize ip,rp,sp for the task
saved-ip ! ( my-up )
sp0 @ saved-sp ! ( my-up )
rp0 @ saved-rp ! ( my-up )
up!
;
\ Establish a word for the task to execute
: start ( cfa task -- )
swap >body swap ( ip task )
set-task
;
\ The test for already-forked relies on the fact that the task pfa
\ initially contains its own address. After forking, the task pfa
\ contains the address of the tasks-user area. Obviously, this
\ test wouldn't work if the first user variable pointed to itself,
\ but it doesn't, so its okay
: fork (s cfa task-pfa -- ) \ give the task a word to execute
\ Make sure the world is set up for multitaking
multi
\ Don't fork if we've already done so
dup dup @ = if tfork then ( cfa task )
start
;
\ Defining word for a task and its action. Example:
\ variable counts
\ background counter begin pause 1 counts +! again ;
: background ( -- )
default-task-size task:
multi
last @ name> >body
dup dup @ = if tfork then ( task )
here swap set-task
!csp ]
;
\ Compiled inside a definition to change the behavior of an
\ existing task, for example (assuming the previous definition of counter):
\ : countdown counter activate begin pause -1 counts +! again ;
: activate ( -- )
r> over set-task wake
;